(FILECREATED " 5-JUL-83 20:51:46" {PHYLUM}<GABRIEL>TRAVERSE.;8 5616   

      changes to:  (VARS TRAVERSECOMS)
		   (PROPS (ROOT GLOBALVAR))
		   (FNS TRAVERSE TADD CREATE-STRUCTURE TIMIT TRAVERS SNB SEED RANDOM TREMOVE TSELECT 
			FIND-ROOT)
		   (RECORDS NODE)

      previous date: " 5-JUL-83 14:06:30" {PHYLUM}<GABRIEL>TRAVERSE.;2)


(PRETTYCOMPRINT TRAVERSECOMS)

(RPAQQ TRAVERSECOMS ((RECORDS NODE)
		     (FNS SNB SEED RANDOM TREMOVE TSELECT TADD CREATE-STRUCTURE FIND-ROOT TRAVERS 
			  TRAVERSE TIMIT TIMIT-10)
		     (BLOCKS
		      (TRAVERSEBLOCK
		       SNB SEED RANDOM TREMOVE TSELECT TADD CREATE-STRUCTURE FIND-ROOT TRAVERS 
		       TRAVERSE TIMIT-10
		       (ENTRIES TRAVERSE CREATE-STRUCTURE TIMIT-10 SNB SEED RANDOM)))
		      (VARS (SN 0)
			   (RAND 21)
			   (COUNT 0)
			   (MARKER NIL))
		     (GLOBALVARS RAND SN MARKER ROOT)
		     (PROP GLOBALVAR ROOT)
		     (SPECVARS COUNT)))
[DECLARE: EVAL@COMPILE 

(DATATYPE NODE ((PARENTS POINTER)
		(SONS POINTER)
		(SN POINTER)
		(ENTRY1 FLAG)
		(ENTRY2 FLAG)
		(ENTRY3 FLAG)
		(ENTRY4 FLAG)
		(ENTRY5 FLAG)
		(ENTRY6 FLAG)
		(MARK FLAG))
	       SN ←(SNB))
]
(/DECLAREDATATYPE (QUOTE NODE)
		  (QUOTE (POINTER POINTER POINTER FLAG FLAG FLAG FLAG FLAG FLAG FLAG)))
(DEFINEQ

(SNB
  (LAMBDA NIL                                                (* JonL " 5-JUL-83 13:21")
    (SETQ SN (ADD1 SN))))

(SEED
  (LAMBDA NIL                                                (* JonL " 5-JUL-83 13:22")
    (SETQ RAND 21)))

(RANDOM
  (LAMBDA NIL                                                (* JonL " 5-JUL-83 13:25")
    (SETQ RAND (IMOD (ITIMES RAND 17)
		     251))))

(TREMOVE
  (LAMBDA (N Q)                                              (* JonL " 5-JUL-83 13:37")
    (COND
      ((EQ (CDR (CAR Q))
	   (CAR Q))
	(PROG1 (CAAR Q)
	       (RPLACA Q NIL)))
      ((ZEROP N)
	(PROG1 (CAAR Q)
	       (bind (P ←(CAR Q)) until (EQ (CDR P)
					    (CAR Q))
		  do (pop P) finally (RETURN (RPLACA Q (RPLACD P (CDR (CAR Q))))))))
      (T (for N (Q ←(CAR Q))
	      (P ←(CDR (CAR Q))) from N by -1 until (ZEROP N)
	    do (pop Q)
	       (pop P)
	    finally (RETURN (PROG1 (CAR Q)
				   (RPLACD Q P))))))))

(TSELECT
  (LAMBDA (N Q)                                              (* JonL " 5-JUL-83 13:37")
    (for N (Q ←(CAR Q)) from N by -1 until (ZEROP N) do (pop Q) finally (RETURN (CAR Q)))))

(TADD
  (LAMBDA (A Q)                                              (* JonL " 5-JUL-83 15:50")
    (COND
      ((NULL Q)
	(PROG ((X (LIST A)))
	      (RPLACD X X)
	      (RETURN (LIST X))))
      ((NULL (CAR Q))
	(PROG ((X (LIST A)))
	      (RPLACD X X)
	      (RETURN (RPLACA Q X))))
      (T (RPLACA Q (RPLACD (CAR Q)
			   (CONS A (CDR (CAR Q)))))))))

(CREATE-STRUCTURE
  (LAMBDA (N)                                                (* JonL " 5-JUL-83 15:51")
    (PROG ((A (LIST (create NODE))))
          (RETURN (for M (P ← A) from (SUB1 N) by -1 until (ZEROP M) do (push A (create NODE))
		     finally (PROGN (SETQ A (LIST (RPLACD P A)))
				    (RETURN (bind (UNUSED ← A)
						  (USED ←(TADD (TREMOVE 0 A)
							       NIL))
						  X Y until (NULL (CAR UNUSED))
					       do (SETQ X (TREMOVE (IMOD (RANDOM)
									 N)
								   UNUSED))
						  (SETQ Y (TSELECT (IMOD (RANDOM)
									 N)
								   USED))
						  (TADD X USED)
						  (push (fetch SONS of Y)
							X)
						  (push (fetch PARENTS of X)
							Y)
					       finally (RETURN (FIND-ROOT (TSELECT 0 USED)
									  N))))))))))

(FIND-ROOT
  (LAMBDA (NODE N)                                           (* JonL " 5-JUL-83 13:58")
    (for N from N by -1 until (ZEROP N) do (COND
					     ((NULL (fetch PARENTS of NODE))
					       (RETURN NODE))
					     (T (SETQ NODE (CAR (fetch PARENTS of NODE)))))
       finally (RETURN NODE))))

(TRAVERS
  (LAMBDA (NODE MARK)                                        (* JonL " 5-JUL-83 15:21")
    (COND
      ((EQ (fetch MARK of NODE)
	   MARK)
	NIL)
      (T (replace MARK of NODE with MARK)
	 (SETQ COUNT (ADD1 COUNT))
	 (replace ENTRY1 of NODE with (NOT (fetch ENTRY1 of NODE)))
	 (replace ENTRY2 of NODE with (NOT (fetch ENTRY2 of NODE)))
	 (replace ENTRY3 of NODE with (NOT (fetch ENTRY3 of NODE)))
	 (replace ENTRY4 of NODE with (NOT (fetch ENTRY4 of NODE)))
	 (replace ENTRY5 of NODE with (NOT (fetch ENTRY5 of NODE)))
	 (replace ENTRY6 of NODE with (NOT (fetch ENTRY6 of NODE)))
	 (for SONS on (fetch SONS of NODE) do (TRAVERS (CAR SONS)
						       MARK))))))

(TRAVERSE
  (LAMBDA (ROOT1)                                            (* JonL " 5-JUL-83 15:58")
    (PROG ((COUNT 0))
          (DECLARE (SPECVARS COUNT)
		   (GLOBALVARS MARKER))
          (TRAVERS ROOT1 (SETQ MARKER (NOT MARKER)))
          (RETURN COUNT))))

(TIMIT
  (LAMBDA NIL                                                (* JonL " 5-JUL-83 15:54")
    (TIMEALL (SETQ ROOT (CREATE-STRUCTURE 100)))
    (TIMEALL (FRPTQ 50 (TRAVERSE ROOT)
		    (TRAVERSE ROOT)
		    (TRAVERSE ROOT)
		    (TRAVERSE ROOT)
		    (TRAVERSE ROOT)))))
(TIMIT-10
  (LAMBDA NIL                                                (* JonL " 5-JUL-83 15:54")
    (PRINT (TIME (SETQ ROOT (CREATE-STRUCTURE 100)) 1 3))
    (PRINT (TIME 
	    (FRPTQ 50
		   (PROGN
		    (TRAVERSE ROOT)
		    (TRAVERSE ROOT)
		    (TRAVERSE ROOT)
		    (TRAVERSE ROOT)
		    (TRAVERSE ROOT))
	     ) 1 3))))
)

(RPAQQ SN 0)

(RPAQQ RAND 21)

(RPAQQ COUNT 0)

(RPAQQ MARKER NIL)
(DECLARE: DOEVAL@COMPILE DONTCOPY

(ADDTOVAR GLOBALVARS RAND SN MARKER ROOT)
)

(PUTPROPS ROOT GLOBALVAR T)
(DECLARE: DOEVAL@COMPILE DONTCOPY

(SPECVARS COUNT)
)
(PUTPROPS TRAVERSE COPYRIGHT (NONE))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (1014 5303 (SNB 1024 . 1150) (SEED 1152 . 1274) (RANDOM 1276 . 1434) (TREMOVE 1436 . 
2041) (TSELECT 2043 . 2267) (TADD 2269 . 2630) (CREATE-STRUCTURE 2632 . 3507) (FIND-ROOT 3509 . 3862) 
(TRAVERS 3864 . 4709) (TRAVERSE 4711 . 4993) (TIMIT 4995 . 5301)))))
STOP